perm filename CODE4.FAI[NEW,LCS]5 blob
sn#372826 filedate 1978-08-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE ITMSUB
C00050 ENDMK
C⊗;
TITLE ITMSUB
INTERNAL ITMSUB,OLDTOP
EXTERNAL BM,NOZERO,LINX,ROFF,CENTX,STF,LINES,.COMM.
EXTERNAL DAT,RHORZ,CLEFS,PLTR,MIN,POSI,ALF,RDRAW
DEFINE R9 <.COMM.+=10 >↔ DEFINE R8<.COMM.+=9 >
DEFINE J2 <.COMM.+3 >↔ DEFINE J10 <.COMM.+=31 >
DEFINE J7 <.COMM.+=28 >
OLDTOP: 0
; 00300 SUBROUTINE ITMSUB
; 00400 IMPLICIT INTEGER(A-Q,S-Z)
; 00500 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1,XDIS
; 00600 COMMON/STF/RSTFAC(0/7),RSTJ2/MIN/MINI,RMINI
; 00700 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,RG,RH/BM/RA,RC,RJY
; 00800 COMMON/POSI/STFF(0/7),JJ2,POS/PLTR/PLT,RHT,DIS,XDIS
; 00900 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
; 01000 1 RJA,YY,DISX,HGT,RZ,INP(53)
; 01100 COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
; 01200 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(R11,
; 01300 1RJQ(9)),(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
; 01400 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
; 01500 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
; 01600 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
; 01700 1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
ITMSUB: 0 ;01800 C RDBR IS SPACER FOR DBL BAR.
MOVSI 3,203700 ; 02000 RST7=RSTJ2*7.
FMPR 3,STF+=8
MOVEM 3,ALF+3 ; 02100 RST18=RSTJ2*18.
MOVSI 02,205440
FMPR 2,STF+=8
MOVEM 02,ALF+4 ;2200 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
MOVE 02,.COMM.+4 ;02400 R3Q=R3
MOVEM 02,ALF+5 ; C NEXT DRAWS STRAIGHT LINES
FMPR 3,.COMM.+5 ; 02700 RD=R4*RST7
MOVEM 3,ALF+7 ; 02800 RA=0
SETZM BM ; 02900 RX=RTF*RSTJ2+POS
MOVE 02,[3.0]
FMPR 02,STF+=8
FADR 02,POSI+=9
MOVEM 02,ALF+=8 ; XDIS=1./DIS > TO REPLACE ALL 1./DIS'S
; 03010 J10=J10*DIS*RSTJ2
FLTR 4,J10 ;MOVE 4,.COMM.+=31
FMPR 4,PLTR+2
FMPR 4,STF+=8
KIFIX 0,4 ;JSA 16,IFIX
MOVEM 0,J10
; THICKNESS DEPENDS ON FINAL SIZE FACTOR (DIS) AND STAFF SIZE.(???!!)
MOVEI 02,62 ; 03100 IF(J5.EQ.50)GO TO 300
CAMN 02,.COMM.+=26
JRST I300 ; 50 IS FOR CRESC., DECRESC. AND BOXES
SKIPN .COMM.+7 ;03300 IF(R6.NE.0)GO TO 401
SKIPE .COMM.+=28
JRST I401 ; IF(J7.NE.0)GO TO 401
; 03500 C FOR BAR LINES
MOVEI 02,54 ; 03600 4000 JA=44
MOVEM 02,.COMM.+1 ;CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
; ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
SETZM DBR# ; 03900 DBR=0
MOVE 2,.COMM.+=25 ;04000 IF(J4.LT.1000)GO TO 400
CAIGE 2,1750
JRST I400
; J4=1001 = DBL BAR, =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
; 04500 DBR=J4/1000
IDIVI 02,1750
MOVEM 02,DBR
MOVEM 3,.COMM.+=25 ; 04600 J4=J4-DBR*1000
; 04700 C DBR=1 HEAVY BAR IS ON R
; 04800 9400 RD=RDBR+RDBR*RSTJ2
I9400: MOVE 1,[3.5]
FMPR 1,STF+=8
FADR 1,[3.5]
MOVEM 1,ALF+7 ; TO SPACE THIN BAR FROM HEAVY
MOVE 02,.COMM.+=26 ;05000 IF(J5.EQ.0)GO TO 400
JUMPE 2,I400
; 05100 C NEXT ADDS REPEAT DOTS TO DBL BAR.
MOVE 3,.COMM.+=25 ;05200 L=J4
MOVEM 3,ALF+=12 ; 05300 RJ=L/100
IDIVI 3,144
FLTR 3,3 ;TLC 3,232000
; FADR 3,3 IF(RJ.EQ.0)RJ=6.*RSTJ2
JUMPN 3,.+3
MOVSI 3,203600
FMPR 3,STF+=8
MOVEM 3,ALF+=11 ; HEAVY BAR WILL BE 5 LINES WIDE.
MOVE .COMM.+4 ; 05600 RZ=R3
MOVEM ALF+=18 ; 05700 J4=0
SETZM .COMM.+=25 ; MUST BE 0 FOR DOTS IN 'NOTWRT'
SKIPE 2,DBR ; J5 IS IN 2 YET!
JRST .+4 ; 05900 IF(DBR.EQ.0)DBR=J5
CAIL 2,4 ;IF(J5.GT.3)J5=3 -- CATCHES TYPOS!
MOVEI 2,3
MOVEM 02,DBR ;IF(DBR.EQ.0)=J5
; 06000 J5=0
SETZM .COMM.+=26 ; J5=1 RPT ↑, =2 RPT ↑, =3 RPT ↑
FSC 1,1 ;06200 RJA=RD*2.
MOVEM 1,ALF+=14
;6300 TO SPACE DOTS, NOT ACCURATE FOR VERY SMALL OR VERY LARGE SIZE FACTORS
MOVEM 2,ALF+6 ; 06400 JY=DBR
CAIGE 2,2 ; 06500 IF(DBR.LT.2)GO TO 8400
JRST I8400
FADR 3,ALF+=18 ; 06600 R3=RJA+RJ+RZ
FADR 3,ALF+=14
MOVEM 3,.COMM.+4
I7400: MOVE 11,ALF+=12 ; 06700 7400 DO 3400 K=J2,MOD(L,100)+J2-1
IDIVI 11,=100
ADD 12,.COMM.+3
SOJ 12, ; 12 IS LIMIT
MOVE 15,.COMM.+3
I4: MOVE 02,STF(15) ;06800 RSTJ2=RSTFAC(K)
MOVEM 02,STF+=8 ; 06900 POS=STFF(K)
MOVE 02,POSI(15)
MOVEM 02,POSI+=9 ; 07000 R4=6
MOVSI 02,203600
MOVEM 02,.COMM.+5 ;07100 CALL CENTX
JSA 16,CENTX ;7200 C SPACES DOTS OUT FROM BAR
;07300 CALL RDRAW(1,17.0,ALF+7OT,STF+=8,.COMM.+4,CENTR+RSTJ2,STF+=8)
MOVE 11,STF+=8
FADR 11,.COMM.+2
JSA 16,RDRAW
JUMP [1]
JUMP [17.0]
JUMP DAT+=69 ;EXTENDED FOR +65 TO +69 1/78
JUMP STF+=8
JUMP .COMM.+4
JUMP 11
JUMP STF+=8 ;7400 C GO GET THE DOT
; 07500 R4=8
MOVSI 02,204400
MOVEM 02,.COMM.+5 ;07600 CALL CENTX
JSA 16,CENTX
;07700 3400 CALL RDRAW(1,17.0,ALF+7OT,STF+=8,.COMM.+4,CENTR+RSTJ2,STF+=8)
I3400: MOVE 11,STF+=8
FADR 11,.COMM.+2
JSA 16,RDRAW
JUMP [1]
JUMP [17.0]
JUMP DAT+=69
JUMP STF+=8
JUMP .COMM.+4
JUMP 11
JUMP STF+=8
CAMGE 15,12
AOJA 15,I4
SOS 2,ALF+6 ; JY=JY-1
CAIGE 2,2 ; IF(JY.LT.2)GO TO 4400
JRST I4400
I8400: MOVE 3,STF+=8
FSC 3,2
FADR 3,ALF+=14 ; R3=RZ-RJA-4.*RSTJ2
FSBR 3,ALF+=18
MOVNM 3,.COMM.+4 ; 08100 GO TO 7400
JRST I7400 ;8200 C DO I NEED ANY MORE RESETS????
I4400: MOVE 02,ALF+=12 ;08300 4400 J4=L
MOVEM 02,.COMM.+=25 ;08400 J7=RJ*DIS
MOVE 02,PLTR+2
FMPR 02,ALF+=11
KIFIX 0,2 ;JSA 16,IFIX
; JUMP 2
MOVEM 00,.COMM.+=28
JRST I5400 ; 08500 GO TO 5400
I400: MOVE 02,.COMM.+=26 ;08600 400 IF(J5.NE.0)GO TO 9400
JUMPN 02,I9400 ; 08700 K=J4/100
MOVE 4,.COMM.+=25
IDIVI 4,144
;8800 C K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
FLTR 4,4 ;8900 J7=K*DIS
FMPR 4,PLTR+2
KIFIX 0,4 ;JSA 16,IFIX
; JUMP 4
MOVEM 00,.COMM.+=28
;9000 C J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
I5400: MOVE 2,.COMM.+=25 ;09100 5400 L=MOD(J4,100)
IDIVI 2,=100
SKIPN 3 ; 09200 IF(L.EQ.0)L=1
SKIPA
SOJ 3, ; 09300 L=L+J2-1
ADD 3,.COMM.+3
MOVEM 3,ALF+=12
;9400 C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
MOVE 02,[3.0] ; 09500 RA=RTF
MOVEM 02,BM
MOVE 3,ALF+=12
CAIG 3,7 ; 09600 IF(L.LE.7)GO TO 2400
JRST I2400 ; 09700 L=7
MOVEI 3,7 ; 09800 RA=300.
MOVSI 02,211454
MOVEM 02,BM ; FOR EXTENDING BARS ABOVE STAFF 7
I2400: MOVE 02,STF(3) ; 10100 RZ=R3Q
MOVEM 02,OLDTOP ; 10000 2400 OLDTOP=RSTFAC(L)
MOVE 02,ALF+5
MOVEM 02,ALF+=18 ; 10200 C SAVE IT FOR DBL RPT BAR.
MOVSI 02,206700 ; 10300 OLDTOP=STFF(L)+(RA+56.)*OLDTOP
FADR 02,BM
FMPR 02,OLDTOP
FADR 02,POSI(3)
MOVEM 02,OLDTOP ; 10400 1400 RA=1
I1400: MOVSI 02,201400
MOVEM 02,BM ; 10500 IF(PLT.GE.0)GO TO 140
MOVE 02,PLTR
JUMPGE 02,I140 ; 10600 J7=J7+1
AOS J7
;; MOVSI 02,201400 ; 10700 RA=1./DIS
MOVE 2,PLTR+3 ;RA=XDIS
MOVEM 02,BM ; 10800 C BAR LINES PLOT AS DOUBLE THICKNESS
I140: MOVE 02,ALF+5 ; 10900 140 RJX=R3Q
MOVEM 02,ALF+=10 ; 11000 42 CALL LINES(R3Q,ALF+=8,3)
I42: JSA 16,LINES
JUMP ALF+5
JUMP ALF+=8
JUMP [3] ;11100 RJ=-1.
MOVN 02,[1.0]
MOVEM 02,ALF+=11 ; 11200 RW=OLDTOP
MOVE 02,OLDTOP
MOVEM 02,ALF+=9 ; 11300 406 CALL LINES(RJX,OLDTOP,2)
I406: JSA 16,LINES
JUMP ALF+=10
JUMP OLDTOP
JUMP [2] ; 11400 IF(J10.EQ.0)GO TO 411
MOVE 02,J10
JUMPE 02,I411 ;P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
MOVEM 02,.COMM.+=28 ;1600 J7=J10
SETZM J10 ; 11700 J10=0
;; MOVSI 02,201400 ; 11800 RA=1./DIS
MOVE 2,PLTR+3 ;RA=XDIS
MOVEM 02,BM ; 11900 411 IF(J7.GT.0)GO TO 409
I411: MOVE 02,.COMM.+=28
JUMPG 02,I409
SKIPG DBR ; 12000 IF(DBR.LE.0)RETURN
JRA 16,(16) ; 12100 OLDTOP=RW
MOVE 02,ALF+=9
MOVEM 02,OLDTOP ; 12300 RA=RZ-RD
MOVN 02,ALF+7
FADR 02,ALF+=18 ; 12400 IF(DBR.NE.1)RA=RJX+RD-1.
MOVEI 3,1
CAMN 3,DBR
JRST .+4
MOVN 02,[1.0]
FADR 02,ALF+7
FADR 02,ALF+=10
MOVEM 02,BM ; 12600 R3Q=RA
MOVEM 02,ALF+5 ; 12500 DBR=DBR-2
MOVNI 02,2
ADDM 02,DBR ; 12700 GO TO 1400
JRST I1400
; 12900 C FOR 'HEAVY' LINE.
I409: MOVE 02,BM ; 13000 409 RJX=RJX+RA
FADRM 02,ALF+=10 ; 13100 CALL LINES(RJX,OLDTOP,2)
JSA 16,LINES
JUMP ALF+=10
JUMP OLDTOP
JUMP [2] ; 13200 J7=J7-1
SOS J7 ; 13300 OLDTOP=RW
MOVE 02,ALF+=9
SKIPGE ALF+=11 ; 13400 IF(RJ)OLDTOP=RX
MOVE 2,ALF+=8
MOVEM 2,OLDTOP ; 13500 RJ=-RJ
MOVNS 00,ALF+=11
JRST I406 ; 13600 GO TO 406
;13900 C DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
; 14700 C FOR CRESC., DECRESC.
I300: MOVE 2,.COMM.+=8 ; 14800 300 IF(R7.EQ.0)R7=2.3
JUMPG 2,.+7
MOVE 3,[2.3]
JUMPE 2,.+4
CAME 2,[-1.0]
JRST .+3
MOVNS 3
MOVEM 3,.COMM.+=8 ; 14900 IF(R7.EQ.-1.)R7=-2.3
MOVM 2,.COMM.+=8 ; 15000 RA=ABS(R7/2.0)*RST7
FSC 02,777777
FMPR 2,ALF+3
MOVEM 2,BM ; 15100 C AMOUNT OF SPREAD
MOVE 3,ALF+5 ; 15200 RJ=R3Q
MOVEM 3,ALF+=11 ; 15300 RX=RX-RST18+RD
MOVN 02,ALF+4
FADR 02,ALF+7
FADRM 02,ALF+=8 ; 15400 IF(R8.NE.0)GO TO 302
MOVE 02,R8
JUMPN 02,I302 ; 15500 C JUMP TO MAKE BOX
JSA 16,RHORZ ; 15600 R6=RHORZ(R6)
JUMP .COMM.+7
MOVEM 00,.COMM.+7 ;15700 IF(R7)GO TO 301
MOVE 02,.COMM.+=8
JUMPL 02,I301 ; 15800 RJ=R6
MOVEM 0,ALF+=11 ; 15900 R6=R3Q
MOVEM 3,.COMM.+7 ;301 CALL LINX(RJ,ALF+=8+RA,.COMM.+7,ALF+=8)
I301: MOVE 14,BM
FADR 14,ALF+=8
JSA 16,LINX
JUMP ALF+=11
JUMP 14
JUMP .COMM.+7
JUMP ALF+=8 ; 16100 CALL LINES(RJ,ALF+=8-RA,2)
MOVN 14,BM
FADR 14,ALF+=8
JSA 16,LINES
JUMP ALF+=11
JUMP 14
JUMP [2] ;FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
SKIPGE PLTR ; 16400 IF(PLT.GE.0)RETURN
SKIPGE .COMM.+=29
JRA 16,(16) ; THIS MAKES ALL CRESC. DBL THICKNESS AT PRINT TIME.
; 16600 IF(J8)RETURN
; 16700 RX=RX+1./DIS
MOVE 2,PLTR+3 ;RX=XDIS
FADRM 02,ALF+=8 ; 16800 J8=-1
SETOM .COMM.+=29 ; 16900 C FOR DOUBLE THICKNESS
; 17000 GO TO 301
JRST I301 ; 17200 302 R8=R8*RST7
I302: MOVE 3,ALF+3
FMPRM 3,.COMM.+=9 ;17300 R9=R9*RST7
MOVE 3,ALF+3
FMPRB 3,R9 ; 17400 IF(R9.EQ.0)R9=R8
JUMPN 3,.+3
MOVE 3,.COMM.+=9
MOVEM 3,.COMM.+=10 ;17500 C R9=0 MAKES SQUARE
MOVE 02,.COMM.+=9 ;17600 R3=R3Q-R8/2.
FSC 02,777777
FSBR 02,ALF+5
MOVNM 02,.COMM.+4 ;17700 RX=RX-R9/2.
FSC 3,777777
FSBR 3,ALF+=8
MOVNM 3,ALF+=8 ; 17710 OLDTOP=RX
MOVNM 3,OLDTOP ; IF(R11.NE.0)OLDTOP=OLDTOP+R11*RST7
MOVE 02,.COMM.+=12
JUMPE 02,.+3
FMPR 02,ALF+3
FADRM 02,OLDTOP ; R11 IS OFFSET FOR PARALLELAGRAM
; 17800 J10=J10
; 17900 C DRAWS BOX, CENTER IS IN MIDDLE
; 18000 C 4,POSI+=9,STF,NT#,50,0,0,,SIZ1↑BY NT#S↑,SIZ2
I1302: MOVE 14,.COMM.+4 ;18100 1302 CALL LINX(R3,ALF+=8,.COMM.+4+R8,OLDTOP)
FADR 14,.COMM.+=9
JSA 16,LINX
JUMP .COMM.+4
JUMP ALF+=8
JUMP 14
JUMP OLDTOP ;18200 CALL LINES(R3+R8,OLDTOP+R9,2)
MOVE 14,.COMM.+4
FADR 14,.COMM.+=9
MOVE 13,OLDTOP
FADR 13,.COMM.+=10
JSA 16,LINES
JUMP 14
JUMP 13
JUMP [2] ; 18300 CALL LINES(R3,ALF+=8+R9,2)
MOVE 14,ALF+=8
FADR 14,.COMM.+=10
JSA 16,LINES
JUMP .COMM.+4
JUMP 14
JUMP [2] ; 18400 CALL LINES(R3,ALF+=8,2)
JSA 16,LINES
JUMP .COMM.+4
JUMP ALF+=8
JUMP [2]
SKIPN J10 ; 18500 IF(J10.EQ.0)RETURN
JRA 16,(16)
SOS J10 ; 18600 J10=J10-1
; 18700 RJ=1./DIS
MOVE 3,PLTR+3 ;RJ=XDIS
MOVEM 3,ALF+=11 ; 18800 R3=R3-RJ
MOVN 02,ALF+=11
FADRM 02,.COMM.+4 ;18900 R8=R8+RJ+RJ
FADR 3,ALF+=11
FADRM 3,.COMM.+=9 ;19000 RX=RX-RJ
FADRM 02,ALF+=8 ; 19010 OLDTOP=OLDTOP-RJ
FADRM 02,OLDTOP ; 19100 R9=R9+RJ+RJ
FADRM 3,.COMM.+=10 ;19200 GO TO 1302
JRST I1302 ;TO THICKEN BOXES. ;1401 R4=2.0
I1401: MOVSI 02,202400
MOVEM 02,.COMM.+5 ;19600 C FOR HEAVY BRACK.
MOVE 2,ALF+3 ; 19700 RA=RST7
MOVEM 02,BM
MOVN 02,BM ; 19800 RX=RX-RA
FADRM 02,ALF+=8 ; 19900 C THE BOTTOM
MOVNI 1,1 ; 20000 L=J4+J2-1
ADD 1,.COMM.+=25
ADD 1,J2
MOVE 3,[3.0] ; 20100 R6=RTF
CAIG 1,7 ; 20200 IF(L.LE.7)GO TO 4401
JRST I4401
MOVEI 1,7 ; 20300 L=7
MOVSI 3,211454 ; 20400 R6=300.
I4401: MOVE 2,POSI(1) ; 20500 4401 RA=STFF(L)
MOVEM 02,BM ; SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
MOVE 02,STF(1) ; 20700 RJY=RSTFAC(L)
MOVEM 02,BM+2 ; OLDTOP=RA+R6*RJY+RJY*56.+RJY*RBX
FADR 3,[63.0]
FMPR 3,BM+2
FADR 3,BM
MOVEM 3,OLDTOP ; 20900 C THE TOP
MOVSI 02,204460 ; 21000 R5=9.5
MOVEM 02,.COMM.+6 ;21100 GO TO 2401
JRST I2401 ; 21300 C DASHES
I401: MOVN 02,ALF+4 ; 21400 401 POS=POS-RST18
FADRM 02,POSI+=9 ; 21600 IF(J7.LE.0)GO TO 407
MOVE 02,.COMM.+=28
JUMPLE 02,I407
CAIN 2,4 ; 21700 IF(J7.EQ.4)GO TO 1401
JRST I1401
CAIE 2,3 ; 21800 IF(J7.NE.3)GO TO 4001
JRST I4001
;21900 NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
I2401: MOVEI 02,3 ; 22000 2401 JA=3
MOVEM 02,.COMM.+1 ;22100 IF(J10.EQ.0)J10=4
MOVE 02,J10
JUMPN 02,.+5
MOVSI 02,203600 ;6.0
FMPR 2,PLTR+2 ;*DIS THICKNES FOLLOWS PLOTTER SIZE
FMPR 2,STF+=8 ;*RSTJ2 AND STAFF SIZE
KIFIX 2,2
MOVEM 02,J10 ; DEFAULT VALUE FOR THICKNESS =4*SIZE FACT.
MOVN 02,[0.33] ; 22300 R4=R4-RBR
FADRM 02,.COMM.+5 ;22400 J9=0
SETZM .COMM.+=30 ; 22500 J5=35
MOVEI 02,43
MOVEM 02,.COMM.+=26 ;22600 C THE NUM FOR THE LITTLE END ITEMS
MOVSI 02,202600 ; 22800 R6=3
MOVEM 02,.COMM.+7 ;22900 R7=0
SETZM .COMM.+=8;DOES LOWER ONE FIRST. ITEM IS IN 'CLEFC.DMD' ON DAT.LCS
SETZM R8 ;R8 MUST BE 0 FOR CLEFS (ELSE IT ACTIVATES THICKENER)
MOVE 02,.COMM.+=29 ; 23100 IF(J8.NE.2)CALL CLEFS
MOVEM 2,RH ;SAVE J8 IN RH (J8 WIPED OUT IN CLEFS)
CAIE 02,2
JSA 16,CLEFS ;P8=1=BOTTOM 1/2 BRACK. ONLY: =2=TOP 1/2 ONLY: 0=COMPLETE
MOVN 3,[0.33] ;23300 R4=R5-RBR
FADR 3,.COMM.+6
MOVEM 3,.COMM.+5 ; 23400 R6=3
MOVSI 02,202600
MOVEM 02,.COMM.+7 ;23500 R7=-3
MOVNM 02,.COMM.+=8 ;23600 C TURNS IT UPSIDE DOWN.
MOVEI 02,4 ;23800 IF(J7.NE.4)GO TO 3401
CAME 02,.COMM.+=28
JRST I3401 ; 23900 POS=RA
MOVE 02,BM
MOVEM 02,POSI+=9 ; 24000 R4=R4*RJY/RSTJ2
FMPR 3,BM+2
FDVR 3,STF+=8
MOVEM 3,.COMM.+5 ;TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
I3401: MOVEI 02,1 ; 24200 3401 IF(J8.NE.1)CALL CLEFS
CAME 02,RH ; RH IS CURRENTLY J8 (INTEGER I.E.)
JSA 16,CLEFS ;24300 R3Q=R3Q-12.0*RSTJ2
MOVSI 02,204600
FMPR 02,STF+=8
FSBRM 02,ALF+5
MOVNS 00,ALF+5 ; 24400 IF(J7.NE.4)GO TO 407
MOVEI 02,4
CAME 02,.COMM.+=28
JRST I407 ; 24500 J7=0
SETZM .COMM.+=28 ; 24600 GO TO 140
JRST I140 ; 24800 4002 J5=5
I4002: MOVEI 02,5 ;FOR CURVY BRACKET. P8 CAN CHANGE WIDTH.
MOVEM 02,.COMM.+=26 ; 25100 J4=J4+J2-1
MOVNI 3,1
ADD 3,.COMM.+3
ADDB 3,.COMM.+=25 ;R7=(.3136*RSTFAC(J4)+.0056*(STFF(J4)-STFF(J2)))/RSTJ2
MOVE 02,[0.3136]
FMPR 02,STF(3)
MOVE 04,POSI(3)
MOVE 03,J2
FSBR 04,POSI(3)
FMPR 04,[0.0056]
FADR 02,4
FDVR 02,STF+=8
MOVEM 02,.COMM.+=8
;25300 .0056=.0392/7.(THE MAGIC NUM FOR VERT SIZE OF BRACK.) .3136=8*.0392
;25400 ADD DIST BETWEEN BOTTOM OF STAVES TO HEIGHT OF TOP STAFF
MOVE 2,.COMM.+=9 ; 25500 IF(R6.EQ.0)R6=1.+R7/20.
SETZM .COMM.+=9 ;***** USE P8 FOR WIDTH FACTOR!! *****
SETZM .COMM.+=29 ;J8=0
JUMPN 2,.+3 ;P6=P8; P8=0
FDVR 02,[20.0]
FADRI 02,201400
MOVEM 02,.COMM.+7 ;25600 JA=3
MOVEI 02,3
MOVEM 02,.COMM.+1 ;25700 R4=2.3
MOVE 02,[2.3]
MOVEM 02,.COMM.+5 ;BECAUSE BRACK DOESN'T REALLY GO UP FROM 0 ?!?X*↑
; 25900 CALL CLEFS
JSA 16,CLEFS ; 26000 RETURN
JRA 16,(16)
I4001: CAIN 2,5 ; 26200 4001 IF(J7.EQ.5)GO TO 4002
JRST I4002 ; J7 IS IN AC2
MOVE 02,.COMM.+=9 ;26300 IF(R8.LE.0)R8=.8
JUMPG 02,.+3 ;NO NEG. NUMBS!!!! 2/78
MOVE 02,[0.8]
MOVEM 02,.COMM.+=9 ;26400 C P8 CAN SET SIZE OF DASH
MOVE 02,[5.96] ; 26402 RZ=5.96*RSTJ2
FMPR 02,STF+=8
MOVEM 02,ALF+=18 ; 26405 RJ=R8*RZ
FMPR 02,.COMM.+=9
MOVEM 02,ALF+=11 ;26410 RZ=R9*RZ
MOVE 3,.COMM.+=10
FMPRM 3,ALF+=18
SKIPN .COMM.+=10 ; 26420 IF(R9.EQ.0)RZ=RJ
MOVEM 02,ALF+=18
;26430 P9 SETS SPACE BETWEEN DASHES. (CAN BE DIFFERENT FROM P8)
; 26440 R8=RJ
MOVEM 02,.COMM.+=9 ;26450 R9=RZ
MOVE 02,ALF+=18
MOVEM 02,.COMM.+=10 ;26500 RD=RD+POS
MOVE 02,POSI+=9
FADRB 02,ALF+7 ; 26600 RJX=RD
MOVEM 02,ALF+=10 ; 27100 RJY=RD
MOVEM 02,BM+2
;26700 =1 =DASHES, P6=P3=VERTICAL; P4=P5=HORIZ.; OTHERWISE SLOPE.
JSA 16,RHORZ ; 26800 J6=ROFF(RHORZ(R6))
JUMP .COMM.+7
MOVE 4,0
JSA 16,ROFF
JUMP 4
KIFIX 0,0
MOVEM 00,.COMM.+=27
SUBM 0,.COMM.+=24 ; 26900 J3=J6-J3
; 27000 J4=J5-J4
MOVE 2,.COMM.+=6 ;NOW J4=R5-R4 (J4 IS FLTING PT)
FSBR 2,.COMM.+5
MOVEM 2,.COMM.+=25 ; CHECKS FOR TILT, USED LATER
FLTR 0,.COMM.+=27 ;MOVE .COMM.+=27 27200 C SAVE FOR THICK LINES
; TLC 0,232000 ; 27300 RA=J6
; FADR 0,0
MOVEM 00,BM ; 27400 C RA IS HORIZ. GOAL FOR DASHES
; 27500 402 OLDTOP=POS+R5*RST7
MOVE 02,ALF+3 ; LABEL 402 NOT USED
FMPR 02,.COMM.+6
FADR 02,POSI+=9
MOVEM 02,OLDTOP ; 27600 IF(J4.EQ.0)GO TO 41
MOVE 3,.COMM.+=25
JUMPE 3,I41 ; 27700 RH=OLDTOP-RD
; 27800 C TOTAL HEIGHT DIFF.
MOVN 3,.COMM.+4 ; 27900 RX=RA-R3
FADR 3,BM
MOVEM 3,ALF+=8 ; 28000 C TOTAL LENGTH DIFF.
FSBR 2,ALF+7 ; 28100 RH=RH/RX
FDVR 02,ALF+=8
MOVEM 02,RH# ; 28200 41 L=3
I41: MOVEI 02,3
MOVEM 02,ALF+=12 ;28300 K=2
MOVEI 02,2
MOVEM 02,ALF+=13 ;28400 416 CALL LINES(R3Q,ALF+7,ALF+=12)
I416: JSA 16,LINES
JUMP ALF+5
JUMP ALF+7
JUMP ALF+=12 ; 28405 IF(J3.EQ.0)GO TO 412
MOVE 02,.COMM.+=24
JUMPE 02,I412 ;28407 C JUMP FOR VERT. DASH
MOVE 3,ALF+5 ;(R3Q) ;28410 IF(J3.GT.0)GO TO 422
JUMPG 02,I422 ; 28420 IF(R3Q.LE.RA)GO TO 413
CAMG 3,BM
JRST I413 ; 28425 C THIS IF P6 IS LESS THAN P3
; 28430 R3Q=R3Q-RJ
MOVN 02,ALF+=11 ; 28440 GO TO 423
JRST I423 ; 28500 422 IF(R3Q.GE.RA)GO TO 413
I422: CAML 3,BM
JRST I413 ; 28600 C JUMP IF ALL DONE
MOVE 02,ALF+=11 ; 28700 R3Q=R3Q+RJ
I423: FADRB 02,ALF+5 ;28710 423 IF(J4.NE.0)RD=RJY+RH*(R3Q-R3)
MOVE 3,.COMM.+=25 ; J4 HAS TILT(SEE I402 -)
JUMPE 3,.+5
FSBR 02,.COMM.+4
FMPR 02,RH
FADR 02,BM+2
MOVEM 02,ALF+7 ;28720 FINDS HEIGHT OF RIGHT SIDE OF SLOPE
I414: MOVE 2,ALF+=12 ; 28800 414 CALL EXCH(L,ALF+=13)
EXCH 2,ALF+=13
MOVEM 2,ALF+=12
MOVE 2,ALF+=11 ; 28810 CALL EXCH(RJ,ALF+=18)
EXCH 2,ALF+=18
MOVEM 2,ALF+=11 ; 28820 C EXCH. SPACE AND DASH SIZE.
JRST I416 ; 28900 GO TO 416
I412: MOVE 1,ALF+7 ;28950 412 IF(J4.GT.0)GO TO 424
MOVE 02,.COMM.+=25
JUMPG 02,I424 ; 28960 IF(RD.LE.OLDTOP)GO TO 413
CAMG 1,OLDTOP
JRST I413 ; 28970 RD=RD-RJ
MOVN 02,ALF+=11
FADRM 02,ALF+7 ; 28980 C THIS IF P5 IS LESS THAN P4.
JRST I414 ; 28990 GO TO 414
I424: CAML 1,OLDTOP ;29000 424 IF(RD.GE.OLDTOP)GO TO 413
JRST I413 ; 29100 C JUMP IF DONE
MOVE 02,ALF+=11 ; 29200 RD=RD+RJ
FADRM 02,ALF+7 ; 29300 GO TO 414
JRST I414 ; 29400 413 IF(J10.GT.0)GO TO 420
I413: MOVE 02,J10
JUMPG 02,I420
SKIPN .COMM.+=32 ; 29410 IF(J11.EQ.0)RETURN
JRA 16,(16)
SKIPGE .COMM.+=24 ; 29415 IF(J3)RJ=-RJ
MOVNS 00,ALF+=11 ; 29420 IF(L.EQ.3)R3Q=R3Q-RJ
MOVEI 02,3
CAME 02,ALF+=12
JRST .+3
MOVN 02,ALF+=11
FADRM 02,ALF+5 ; 29430 RX=R8
MOVE 02,.COMM.+=9
MOVEM 02,ALF+=8
SKIPGE .COMM.+=32 ; 29440 IF(J11)RX=-RX
MOVNS 00,ALF+=8 ;29450 CALL LINX(R3Q,ALF+7,ALF+5,ALF+7+RX)
MOVE 14,ALF+7
FADR 14,ALF+=8
JSA 16,LINX
JUMP ALF+5
JUMP ALF+7
JUMP ALF+5
JUMP 14 ; 29460 C PUTS BRACK END ON DASHED LINE. (P11=1 OR -1)
; 29470 RETURN
JRA 16,(16) ; 29500 C NEXT FOR THICK DASHES
; 29600 420 J10=J10-1
I420: SOS J10 ; 29650 RJ=1./DIS
MOVE 3,PLTR+3 ;AC3=XDIS
;; FDVR 3,PLTR+2 ; 29700 IF(J3.EQ.0)GO TO 415
MOVE 02,.COMM.+=24
JUMPE 02,I415 ; 29800 R3Q=R3
MOVE 02,.COMM.+4
MOVEM 02,ALF+5 ; 29900 RJY=RJY+RJ
FADRB 3,BM+2 ;29950 RD=RJY
MOVEM 3,ALF+7 ;30000 GO TO 417
JRST I417 ; 30100 415 R3Q=R3Q+RJ
I415: FADRM 3,ALF+5 ; 30200 RD=RJX
MOVE 02,ALF+=10
MOVEM 02,ALF+7 ;30210 417 RJ=R8
I417: MOVE 02,.COMM.+=9
MOVEM 02,ALF+=11 ; 30220 RZ=R9
MOVE 02,.COMM.+=10
MOVEM 02,ALF+=18 ; 30230 C FOR THICK DASHES.
; 30300 GO TO 41
JRST I41 ; 30600 407 RX=RD+POS
I407: MOVE 02,ALF+7
FADR 02,POSI+=9
MOVEM 02,ALF+=8 ; 30700 OLDTOP=R5*RST7+POS
MOVE 02,ALF+3
FMPR 02,.COMM.+6
FADR 02,POSI+=9
MOVEM 02,OLDTOP
MOVMS .COMM.+=9 ;***** R8=ABS(R8) NO NEG, TOLERATED!!! 2/78
MOVE 3,.COMM.+=28 ; 30800 IF(J7.EQ.3)GO TO 140
CAIN 3,3
JRST I140 ; 30900 CALL NOZERO(R9)
JSA 16,NOZERO
JUMP .COMM.+=10
CAMN 3,[-1] ; 31000 IF(J7.EQ.-1)GO TO 408
JRST I408
; 31100 C FOR 'TR' J7=-2, 'ARPEGG' J7=-1, STRAIGHT LINES J7=0
; 31200 CC WHY THE IFIX???? RJX=IFIX(RHORZ(R6))
JSA 16,RHORZ ; 31300 RJX=IFIX(ROFF(RHORZ(R6)))
JUMP .COMM.+7
MOVE 4,
JSA 16,ROFF
JUMP 4
KIFIX 0,0 ;MOVE 4,
; JSA 16,IFIX
; JUMP 4
FLTR 0,0 ;TLC 0,232000
;FADR 0,0
MOVEM 00,ALF+=10
;31400 C ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
MOVE 02,.COMM.+=28 ;31500 IF(J7.EQ.0)GO TO 42
JUMPE 3,I42 ; 31600 OLDTOP=R9*RST7+RX
MOVE 02,ALF+3
FMPR 02,.COMM.+=10
FADR 02,ALF+=8
MOVEM 02,OLDTOP ; 31700 CALL NOZERO(R8)
JSA 16,NOZERO
JUMP .COMM.+=9 ; 31800 4041 RZ=RX
I4041: MOVE 02,ALF+=8
MOVEM 02,ALF+=18 ; 31900 RH=OLDTOP
MOVE 14,OLDTOP
MOVEM 14,RH ;32000 C SAVE FOR THICK WIGGLES
JSA 16,LINES ;32100 CALL LINES(R3Q,ALF+=8,3)
JUMP ALF+5
JUMP ALF+=8
JUMP [3] ; 32200 C DRAWS STRAIGHT LINES. ETC.
MOVE 02,ALF+5 ; 32300 R9=R3Q
MOVEM 02,.COMM.+=10 ;32400 RJ=OLDTOP
MOVEM 14,ALF+=11 ; 32500 RW=3.*RSTJ2*R8
MOVSI 02,202600
FMPR 02,STF+=8
FMPR 02,.COMM.+=9
MOVEM 02,ALF+=9 ; 32600 RA=RW*2.5
MOVSI 02,202500
FMPR 02,ALF+=9
MOVEM 02,BM ; P8=HORZ. WIGGLE SIZE; P9=VERT. SIZE
I404: MOVE 02,BM ; 32800 404 R9=R9+RA
FADRM 02,.COMM.+=10 ;32900 CALL LINES(R9,ALF+=11,2)
JSA 16,LINES
JUMP .COMM.+=10
JUMP ALF+=11
JUMP [2] ; 33000 R9=R9+RW
MOVE 14,ALF+=9
FADRB 14,.COMM.+=10 ;33100 CALL LINES(R9,ALF+=11,2)
JSA 16,LINES
JUMP .COMM.+=10
JUMP ALF+=11
JUMP [2]
I405: MOVE ALF+=8 ; 33200 405 CALL EXCH(RX,ALF+=11)
EXCH ALF+=11
MOVEM ALF+=8
CAMGE 14,ALF+=10 ; 33300 IF(R9.LT.RJX)GO TO 404
JRST I404
SKIPG .COMM.+=31 ; 33400 IF(J10.LE.0)RETURN
JRA 16,(16)
MOVE 2,PLTR+3 ;OLDTOP=XDIS
MOVEM 02,OLDTOP ; 33500 RX=RZ+OLDTOP
FADR 02,ALF+=18
MOVEM 02,ALF+=8 ; 33600 OLDTOP=RH+OLDTOP
MOVE 02,RH
FADRM 02,OLDTOP
SOS .COMM.+=31 ; 33700 J10=J10-1
JRST I4041 ; 33800 GO TO 4041
; 33900 C P10= + NUM OF THICKNESSES TO WIGGLE
I408: MOVE 02,ALF+=8 ;34100 408 IF(RX.GT.OLDTOP)CALL EXCH(RX,OLDTOP)
CAMLE 2,OLDTOP
EXCH 2,OLDTOP
MOVEM 2,ALF+=8 ; 34200 RZ=R9*RSTJ2*5.96
MOVE 02,STF+=8
FMPR 02,.COMM.+=10
FMPR 02,[5.96]
MOVEM 02,ALF+=18 ;USE P9 TO SET WIGGLE WIDTH. P8 TO SET HGT.
JSA 16,NOZERO ; 34400 CALL NOZERO(R8)
JUMP .COMM.+=9 ; 34500 RD=R8*RST7*.5
MOVE 02,ALF+3
FMPR 02,.COMM.+=9
FSC 02,777777
MOVEM 02,ALF+7 ; 34600 RJ=RD
MOVEM 02,ALF+=11 ; 34700 IF(RD.LT.1.)RD=1.
MOVSI 02,201400
CAMLE 02,ALF+7
MOVEM 2,ALF+7 ; 34800 421 R9=RX
I421: MOVE 02,ALF+=8
MOVEM 02,.COMM.+=10 ;34900 RW=R3Q
MOVE 02,ALF+5
MOVEM 02,ALF+=9 ; 35000 RA=RZ+R3Q
FADR 02,ALF+=18
MOVEM 02,BM ;35100 CALL LINES(RW,.COMM.+=10,3)
JSA 16,LINES
JUMP ALF+=9
JUMP .COMM.+=10
JUMP [3] ; 35200 410 R9=R9+RJ
I410: MOVE 02,ALF+=11
FADRM 02,.COMM.+=10 ;35300 CALL LINES(RA,.COMM.+=10,2)
JSA 16,LINES
JUMP BM
JUMP .COMM.+=10
JUMP [2] ; 35400 R9=R9+RD
MOVE 02,ALF+7
FADRM 02,.COMM.+=10 ;35500 CALL LINES(RA,.COMM.+=10,2)
JSA 16,LINES
JUMP BM
JUMP .COMM.+=10
JUMP [2]
MOVE BM ; 35600 CALL EXCH(RA,ALF+=9)
EXCH ALF+=9
MOVEM BM ; 35700 IF(R9.LT.OLDTOP)GO TO 410
MOVE 02,OLDTOP
CAMLE 02,.COMM.+=10
JRST I410
SKIPG .COMM.+=31 ; 35800 IF(J10.LE.0)RETURN
JRA 16,(16) ; 35900 R3Q=R3Q+1./DIS
MOVE 2,PLTR+3 ;XDIS
FADRM 02,ALF+5
SOS .COMM.+=31 ; 36000 J10=J10-1
JRST I421 ; 36100 GO TO 421
JRA 16,(16) ;36200 C VERTICAL WIGGLE P10=+ NUM OF THICKNESSES.
END ; 36300 END